home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok25 / timersupport / timersupport.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  189 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    TimerSupport.mod
  4.     :Contents.   support to handle the timer.device
  5.     :Author.     Hartmut Höhn
  6.     :Address.    Friedenstraße 1, D 6255 Dornburg 5
  7.     :Copyright.  Public Domain
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga A+L V3.2d
  10.     :History.    V1.0 Harmut Höhn 27.Dec.1988
  11.     :History.    V1.1 [bne] 18.May.1989 (- MODIV, cosmetics)
  12.     :History.    V1.2 [bne] 29.May.1989 (bugs fixed, compiler V3.2)
  13.     :History.    V2.0 [bne] 06.Aug.1989 (+ inline doc, optimized)
  14.     :History.    V2.1 [bne] 03.Sep.1989 (new Add/Sub/CmpTime)
  15.  
  16. **********************************************************************)
  17.  
  18. IMPLEMENTATION MODULE TimerSupport;
  19.  
  20. (* Copyright (c) 1988, 1989 by Hartmut Höhn & Nicolas Benezan *)
  21.  
  22. FROM Arts        IMPORT Assert, TermProcedure;
  23. FROM Exec        IMPORT CloseDevice, DoIO, invalid, MsgPortPtr, OpenDevice,
  24.                         DevicePtr;
  25. FROM ExecSupport IMPORT CreateExtIO, CreatePort, DeleteExtIO, DeletePort;
  26. FROM SYSTEM      IMPORT ADR, LONGSET;
  27. FROM Timer       IMPORT addRequest, getSysTime, IOTimer, IOTimerPtr,
  28.                         setSysTime, timerName, TimeVal;
  29. IMPORT Timer;
  30.  
  31. VAR
  32.   timerBase  : DevicePtr;
  33.   timerReqPtr: IOTimerPtr;
  34.   open       : INTEGER;
  35.  
  36. CONST
  37.   micPerSec   = 1000000;
  38.   secsPerMin  = 60;
  39.   minsPerHour = 60;
  40.   hoursPerDay = 24;
  41.   daysPerYear = 365;
  42.   daysPerLeap = 4*daysPerYear+1;
  43.   notOpen     = "timer.device not open";
  44.  
  45. PROCEDURE CloseTimer;
  46.   BEGIN
  47.     DEC(open);
  48.     IF open=0 THEN
  49.       CloseDevice(timerReqPtr);
  50.       DeleteExtIO(timerReqPtr);
  51.       DeletePort(timerPort);
  52.     END;
  53.   END CloseTimer;
  54.  
  55. PROCEDURE OpenTimer(Mode: TimerMode): BOOLEAN;
  56.   BEGIN
  57.     IF open=0 THEN
  58.       timerPort:=CreatePort(NIL, 0);
  59.       IF timerPort#NIL THEN
  60.         timerReqPtr:=CreateExtIO(timerPort, SIZE(IOTimer));
  61.         IF timerReqPtr#NIL THEN
  62.           OpenDevice(ADR(timerName), ORD(Mode), timerReqPtr, LONGSET{});
  63.           IF timerReqPtr^.node.error=0 THEN
  64.             INC(open);
  65.             timerBase:=timerReqPtr^.node.device;
  66.             RETURN TRUE;
  67.           END;
  68.           DeleteExtIO(timerReqPtr);
  69.         END;
  70.         DeletePort(timerPort);
  71.       END;
  72.       RETURN FALSE
  73.     END;
  74.     INC(open);
  75.     RETURN TRUE
  76.   END OpenTimer;
  77.  
  78. PROCEDURE TimerWait(Time: TimeVal);
  79.   BEGIN
  80.     Assert(open>0, ADR(notOpen));
  81.     WITH timerReqPtr^ DO
  82.       node.command:=addRequest;
  83.       time:=Time;
  84.     END;
  85.     DoIO(timerReqPtr);
  86.   END TimerWait;
  87.  
  88. PROCEDURE GetSysTime(VAR Time: TimeVal);
  89.   BEGIN
  90.     Assert(open>0, ADR(notOpen));
  91.     timerReqPtr^.node.command:=getSysTime;
  92.     DoIO(timerReqPtr);
  93.     Time:=timerReqPtr^.time
  94.   END GetSysTime;
  95.  
  96. PROCEDURE SetSysTime(Time: TimeVal);
  97.   BEGIN
  98.     Assert(open>0, ADR(notOpen));
  99.     WITH timerReqPtr^ DO
  100.       node.command:=setSysTime;
  101.       time:=Time;
  102.     END;
  103.     DoIO(timerReqPtr);
  104.   END SetSysTime;
  105.  
  106. PROCEDURE SysToNormalTime(    SysTime: TimeVal;
  107.                           VAR Year, Month, Day: LONGINT;
  108.                           VAR Hour, Minute, Second: LONGINT);
  109.   BEGIN
  110.     Second:=SysTime.secs;
  111.     Minute:=Second DIV secsPerMin;
  112.     Second:=Second MOD secsPerMin;
  113.     Hour:=Minute DIV minsPerHour;
  114.     Minute:=Minute MOD minsPerHour;
  115.     Day:=Hour DIV hoursPerDay;
  116.     Hour:=Hour MOD hoursPerDay;
  117.     DEC(Day, 790);                    (* offset 1.Jan.78 to 1.Mar.1980 *)
  118.     Year:=(4*Day+3) DIV daysPerLeap;
  119.     DEC(Day, daysPerLeap*Year DIV 4);
  120.     Month:=(5*Day+2) DIV 153;         (* 0=Mar ... 11=Feb next year *)
  121.     DEC(Day,(153*Month+2) DIV 5);
  122.     INC(Day);
  123.     INC(Month, 3);                    (* Mar=3 ... next Feb=14 *)
  124.     IF Month>12 THEN
  125.       INC(Year);
  126.       DEC(Month, 12);
  127.     END;
  128.     INC(Year, 1980);
  129.   END SysToNormalTime;
  130.  
  131. PROCEDURE NormalToSysTime(    Year, Month, Day: LONGINT;
  132.                               Hour, Minute, Second: LONGINT;
  133.                           VAR SysTime: TimeVal);
  134.   BEGIN
  135.     DEC(Year, 1980);
  136.     DEC(Month, 3);                    (* 0=Mar ... 11=Feb next year *)
  137.     IF Month<0 THEN
  138.       INC(Month, 12);
  139.       DEC(Year);
  140.     END;
  141.     DEC(Day);
  142.     INC(Day, (153*Month+2) DIV 5);
  143.     INC(Day, daysPerLeap*Year DIV 4);
  144.     INC(Day, 790);
  145.     INC(Hour, Day*hoursPerDay);
  146.     INC(Minute, Hour*minsPerHour);
  147.     INC(Second, Minute*secsPerMin);
  148.     WITH SysTime DO
  149.       secs:=Second;
  150.       micro:=0;
  151.     END;
  152.   END NormalToSysTime;
  153.  
  154. PROCEDURE NewTimerRequest(RequestPtr: IOTimerPtr);
  155.   BEGIN
  156.     Assert(open>0, ADR(notOpen));
  157.     RequestPtr^:=timerReqPtr^;
  158.     WITH RequestPtr^.node DO
  159.       command:=invalid;
  160.       error:=0;
  161.     END;
  162.   END NewTimerRequest;
  163.  
  164. PROCEDURE AddTime(VAR dest: TimeVal;
  165.                       source: TimeVal);
  166.   BEGIN
  167.     Assert(open>0, ADR(notOpen));
  168.     Timer.AddTime(timerBase, ADR(dest), ADR(source));
  169.   END AddTime;
  170.  
  171. PROCEDURE SubTime(VAR dest: TimeVal;
  172.                       source: TimeVal);
  173.   BEGIN
  174.     Assert(open>0, ADR(notOpen));
  175.     Timer.SubTime(timerBase, ADR(dest), ADR(source));
  176.   END SubTime;
  177.  
  178. PROCEDURE CmpTime(time1, time2: TimeVal): INTEGER;
  179.   BEGIN
  180.     Assert(open>0, ADR(notOpen));
  181.     RETURN Timer.CmpTime(timerBase, ADR(time1), ADR(time2));
  182.   END CmpTime;
  183.  
  184. BEGIN
  185.   open:=0;
  186.   TermProcedure(CloseTimer);
  187. END TimerSupport.
  188.  
  189.